home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / tests / switch.test < prev    next >
Text File  |  1993-06-17  |  6KB  |  185 lines
  1. # Commands covered:  switch
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27. # $Header: /user6/ouster/tcl/tests/RCS/switch.test,v 1.2 93/06/17 11:53:58 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30.  
  31. test switch-1.1 {simple patterns} {
  32.     switch a a {format 1} b {format 2} c {format 3} default {format 4}
  33. } 1
  34. test switch-1.2 {simple patterns} {
  35.     switch b a {format 1} b {format 2} c {format 3} default {format 4}
  36. } 2
  37. test switch-1.3 {simple patterns} {
  38.     switch x a {format 1} b {format 2} c {format 3} default {format 4}
  39. } 4
  40. test switch-1.4 {simple patterns} {
  41.     switch x a {format 1} b {format 2} c {format 3}
  42. } {}
  43. test switch-1.5 {simple pattern matches many times} {
  44.     switch b a {format 1} b {format 2} b {format 3} b {format 4}
  45. } 2
  46. test switch-1.6 {simple patterns} {
  47.     switch default a {format 1} default {format 2} c {format 3} default {format 4}
  48. } 2
  49. test switch-1.7 {simple patterns} {
  50.     switch x a {format 1} default {format 2} c {format 3} default {format 4}
  51. } 4
  52.  
  53. test switch-2.1 {single-argument form for pattern/command pairs} {
  54.     switch b {
  55.     a {format 1}
  56.     b {format 2}
  57.     default {format 6}
  58.     }
  59. } {2}
  60. test switch-2.2 {single-argument form for pattern/command pairs} {
  61.     list [catch {switch z {a 2 b}} msg] $msg
  62. } {1 {extra switch pattern with no body}}
  63.  
  64. test switch-3.1 {-exact vs. -glob vs. -regexp} {
  65.     switch -exact aaaab {
  66.     ^a*b$    {concat regexp}
  67.     *b    {concat glob}
  68.     aaaab    {concat exact}
  69.     default    {concat none}
  70.     }
  71. } exact
  72. test switch-3.2 {-exact vs. -glob vs. -regexp} {
  73.     switch -exact -regexp aaaab {
  74.     ^a*b$    {concat regexp}
  75.     *b    {concat glob}
  76.     aaaab    {concat exact}
  77.     default    {concat none}
  78.     }
  79. } regexp
  80. test switch-3.3 {-exact vs. -glob vs. -regexp} {
  81.     switch -glob aaaab {
  82.     ^a*b$    {concat regexp}
  83.     *b    {concat glob}
  84.     aaaab    {concat exact}
  85.     default    {concat none}
  86.     }
  87. } glob
  88. test switch-3.4 {-exact vs. -glob vs. -regexp} {
  89.     switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
  90.         aaaab {concat exact} default {concat none}
  91. } exact
  92. test switch-3.5 {-exact vs. -glob vs. -regexp} {
  93.     switch -- -glob {
  94.     ^g.*b$    {concat regexp}
  95.     -*    {concat glob}
  96.     -glob    {concat exact}
  97.     default {concat none}
  98.     }
  99. } exact
  100. test switch-3.6 {-exact vs. -glob vs. -regexp} {
  101.     list [catch {switch -foo a b c} msg] $msg
  102. } {1 {bad option "-foo": should be -exact, -glob, -regexp, or --}}
  103.  
  104. test switch-4.1 {error in executed command} {
  105.     list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
  106.         $msg $errorInfo
  107. } {1 {Just a test} {Just a test
  108.     while executing
  109. "error "Just a test""
  110.     ("a" arm line 1)
  111.     invoked from within
  112. "switch a a {error "Just a test"} default {format 1}"}}
  113. test switch-4.2 {error: not enough args} {
  114.     list [catch {switch} msg] $msg
  115. } {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
  116. test switch-4.3 {error: pattern with no body} {
  117.     list [catch {switch a b} msg] $msg
  118. } {1 {extra switch pattern with no body}}
  119. test switch-4.4 {error: pattern with no body} {
  120.     list [catch {switch a b {format 1} c} msg] $msg
  121. } {1 {extra switch pattern with no body}}
  122. test switch-4.5 {error in default command} {
  123.     list [catch {switch foo a {error switch1} b {error switch 3} \
  124.         default {error switch2}} msg] $msg $errorInfo
  125. } {1 switch2 {switch2
  126.     while executing
  127. "error switch2"
  128.     ("default" arm line 1)
  129.     invoked from within
  130. "switch foo a {error switch1} b {error switch 3}  default {error switch2}"}}
  131.  
  132. test switch-5.1 {errors in -regexp matching} {
  133.     list [catch {switch -regexp aaaab {
  134.     *b    {concat glob}
  135.     aaaab    {concat exact}
  136.     default    {concat none}
  137.     }} msg] $msg
  138. } {1 {couldn't compile regular expression pattern: ?+* follows nothing}}
  139.  
  140. test switch-6.1 {backslashes in patterns} {
  141.     switch -exact {\a\$\.\[} {
  142.     \a\$\.\[    {concat first}
  143.     \a\\$\.\\[    {concat second}
  144.     \\a\\$\\.\\[    {concat third}
  145.     {\a\\$\.\\[}    {concat fourth}
  146.     {\\a\\$\\.\\[}    {concat fifth}
  147.     default        {concat none}
  148.     }
  149. } third
  150. test switch-6.2 {backslashes in patterns} {
  151.     switch -exact {\a\$\.\[} {
  152.     \a\$\.\[    {concat first}
  153.     {\a\$\.\[}    {concat second}
  154.     {{\a\$\.\[}}    {concat third}
  155.     default        {concat none}
  156.     }
  157. } second
  158.  
  159. test switch-7.1 {"-" bodies} {
  160.     switch a {
  161.     a -
  162.     b -
  163.     c {concat 1}
  164.     default {concat 2}
  165.     }
  166. } 1
  167. test switch-7.2 {"-" bodies} {
  168.     list [catch {
  169.     switch a {
  170.         a -
  171.         b -
  172.         c -
  173.     }
  174.     } msg] $msg
  175. } {1 {no body specified for pattern "a"}}
  176. test switch-7.3 {"-" bodies} {
  177.     list [catch {
  178.     switch a {
  179.         a -
  180.         b -foo
  181.         c -
  182.     }
  183.     } msg] $msg
  184. } {1 {invalid command name: "-foo"}}
  185.